PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/ownerd.exe/TESTOWNE.PAS

Pascal/Delphi Source File | 1992-04-16 | 5.0 KB | 198 lines

{Program to test the UOwnerDraw unit. Displays two units, one holding
text strings and one hatch styles. Both of these controls are displayed by
the program rather than Windows.

Note that although the list box can hold a string, it just a longint to the
code so it does not carry out any memory management. All memory manipulation
MUST be done by the application, as shown here.



16th April 1992.

Rex K. Perkins, CIS 70651,1611

}




Program TestOwnerDraw;

Uses WinTypes, WinProcs, WObjectB, Strings, UOwnerDraw;

Const
     AppName='TestOwner';

     id_TextListBox=100;
     id_GraphicsListBox=101;


Type


  TTestOwnerApplication = object(TApplication)
    Procedure InitMainWindow; virtual;
  End;


  PGraphicsListBox=^TGraphicsListBox;
  TGraphicsListBox=Object(TOwnerDrawListBox)

    Procedure DrawItem(DrawStruct:PDrawItemStruct); Virtual;
       {Draw the actual item in DrawStruct. Just draw it, everything else is
       taken care of}
  End;


  PTestOwnerWindow = ^TTestOwnerWindow;
  TTestOwnerWindow = object(TWindow)
    TextListBox:POwnerDrawListBox;
    GraphicsListBox:PGraphicsListBox;

    Constructor Init(AParent: PWindowsObject; ATitle: PChar);

    Destructor Done; Virtual;

    Procedure SetUpWindow; Virtual;

    Procedure WMDrawItem(Var Msg:TMessage); Virtual wm_First+wm_DrawItem;

  End;


Procedure TTestOwnerApplication.InitMainWindow;
Begin
  MainWindow := New(PTestOwnerWindow, Init(nil, AppName))
End;


Constructor TTestOwnerWindow.Init(AParent: PWindowsObject; ATitle: PChar);

Begin
  TWindow.Init(AParent, ATitle);
  TextListBox:=New(POwnerDrawListBox,Init(@Self,id_TextListBox,10,10,200,200));
  GraphicsListBox:=New(PGraphicsListBox,Init(@Self,id_GraphicsListBox,220,10,200,200));
  EnableKBHandler
End;



Procedure TTestOwnerWindow.SetUpWindow;

{Fill up window the list boxes}

Var Count:Word;
    TempStr:String;

Begin
  TWindow.SetUpWindow;
  If TextListBox<>Nil Then              {Put 20 strings into the text box}
    For Count:=1 To 20 Do
      Begin
        Str(Count,TempStr);
        TempStr:='A string. Number '+TempStr+#0;
        SendMessage(TextListBox^.HWindow,lb_AddString,0,LONGINT(StrNew(@TempStr[1])))  {We can't use the string methods}
      End;

  If GraphicsListBox<>Nil Then              {Put some fill styles into the graphics list box}
    Begin
      SendMessage(GraphicsListBox^.HWindow,lb_AddString,0,hs_BDiagonal);
      SendMessage(GraphicsListBox^.HWindow,lb_AddString,0,hs_Cross);
      SendMessage(GraphicsListBox^.HWindow,lb_AddString,0,hs_DiagCross);
      SendMessage(GraphicsListBox^.HWindow,lb_AddString,0,hs_FDiagonal);
      SendMessage(GraphicsListBox^.HWindow,lb_AddString,0,hs_Horizontal);
      SendMessage(GraphicsListBox^.HWindow,lb_AddString,0,hs_Vertical)
    End
End;


Destructor TTestOwnerWindow.Done;

{Free all strings and quit. The list box will not free the strings it's holding,
after all, it does not know it's got any strings! (Different kind of OwnerDraw)}

Var Count:Integer;

Begin
  If TextListBox<>Nil Then
    Begin
      Count:=TextListBox^.GetCount-1;
      While Count>=0 Do
        Begin
          StrDispose(PCHAR(SendMessage(TextListBox^.HWindow,lb_GetItemData,Count,0)));
          DEC(Count)
        End
    End;
  TWindow.Done
End;




    Procedure TTestOwnerWindow.WMDrawItem(Var Msg:TMessage);

    {A request to draw an onwner draw control was received. Check which
    list box it is for and forward it.}

    Var Dummy:PDrawItemStruct;

    Begin
      If PDrawItemStruct(Msg.LParam)<>Nil Then {Ignore invalid parameters!}
        If (PDrawItemStruct(Msg.LParam)^.CtlID=id_TextListBox) AND (TextListBox<>Nil) Then
          TextListBox^.WMDrawItem(PDrawItemStruct(Msg.LParam))
        Else
          If (PDrawItemStruct(Msg.LParam)^.CtlID=id_GraphicsListBox) AND (GraphicsListBox<>Nil) Then
            GraphicsListBox^.WMDrawItem(PDrawItemStruct(Msg.LParam))
    End;



    Procedure TGraphicsListBox.DrawItem(DrawStruct:PDrawItemStruct);

    {Draw a filled box as indicated by the ItemData field}

    Var NewBrush,OldBrush:HBrush;

    Begin
                {Create a brush and select it}
      If DrawStruct^.ItemID AND $8000 =0 Then  {Test for index=-1}
        Begin
          NewBrush:=CreateHatchBrush(DrawStruct^.ItemData,GetTextColor(DrawStruct^.HDc));
          OldBrush:=SelectObject(DrawStruct^.HDc,NewBrush)
        End;

                {Draw a rectangle}
      Rectangle(DrawStruct^.HDc,DrawStruct^.rcItem.Left,DrawStruct^.rcItem.Top,
                DrawStruct^.rcItem.Right,DrawStruct^.rcItem.Bottom);

                {Restore the old brush & delete the new one}
      If DrawStruct^.ItemID AND $8000 =0 Then  {Test for index=-1}
        Begin
          SelectObject(DrawStruct^.HDc,OldBrush);
          DeleteObject(NewBrush)
        End
    End;





Var

  TestApp: TTestOwnerApplication;

Begin
  TestApp.Init(AppName);
  TestApp.Run;
  TestApp.Done
End.